home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
psgui130.zip
/
PGUIWIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-01
|
25KB
|
969 lines
{
╔══════════════════╗
║ PGUI Graphic ║
║ Window Include ║
║ Rev. 1.00 ║
╚══════════════════╝
}
Procedure GraphicWindow.SaveBackground;
Begin
Mouse.Hide;
Size:=ImageSize(X1,Y1,X2,Y2);
If Size>MaxAvail Then Error(1);
GetMem(Save,Size);
GetImage(X1,Y1,X2,Y2,Save^);
Mouse.Show;
End;
Procedure GraphicWindow.DrawWindow;
Var
X :Byte;
Old:Record
Color:Word;
Style:FillSettingsType;
End;
Begin
Mouse.Hide;
Old.Color:=GetColor;
GetFillSettings(Old.Style);
SetColor (BoxBck);
Line(X1+1,Y1,X2-1,Y1); {-----}
Line(X1,Y1+1,X1,Y2-1); {|< |}
Line(X2,Y1+1,X2,Y2-1); {| >|}
Line(X1+1,Y2,X2-1,Y2); {-----}
SetColor (BoxFrg);
SetFillStyle (Pattern,FillColor);
For X:=1 to Thickness do
Rectangle(X1+X,Y1+X,X2-X,Y2-X);
Inc(X);
Bar(X1+X,Y1+X,X2-X,Y2-X);
PutPixel(X1+1,Y1+1,BoxBck);
PutPixel(X2-1,Y2-1,BoxBck);
PutPixel(X2-1,Y1+1,BoxBck);
PutPixel(X1+1,Y2-1,BoxBck);
PutPixel(X1+X,Y1+X,BoxFrg);
PutPixel(X2-X,Y2-X,BoxFrg);
PutPixel(X2-X,Y1+X,BoxFrg);
PutPixel(X1+X,Y2-X,BoxFrg);
SetColor(Old.Color);
SetFillStyle(Old.Style.Pattern,Old.Style.Color);
Mouse.Show;
End;
Procedure GraphicWindow.Open(NX1,NY1,NX2,NY2,Forg,Back,
Thick,Patrn,PatClr:Word;KeepBackground:Boolean);
Begin
Buttons.Init;
HdrButtonNum :=0;
VSlideButtonNum :=0;
VSlideBarButtonNum :=0;
VSlideButtonUpNum :=0;
VSlideButtonDownNum :=0;
VSlideBarMaxPos :=0;
VSlideBarCurPos :=0;
HSlideButtonNum :=0;
HSlideBarButtonNum :=0;
HSlideButtonLeftNum :=0;
HSlideButtonRightNum:=0;
HSlideBarMaxPos :=0;
HSlideBarCurPos :=0;
VSlideBarPat :=0;
VSlideBarClr :=0;
HSlideBarPat :=0;
HSlideBarClr :=0;
CloseButtonNum :=0;
KeepBack :=KeepBackground;
Status :=Visible;
Header :='';
BoxFrg :=Forg;
BoxBck :=Back;
Thickness :=Thick;
Pattern :=Patrn;
FillColor :=PatClr;
X1 :=NX1;
Y1 :=NY1;
X2 :=NX2;
Y2 :=NY2;
If KeepBack Then
SaveBackground
Else
Begin
Size:=0;
Save:=NIL;
End;
DrawWindow;
End;
Procedure GraphicWindow.DisplayHeading;
Var
XPos:Word;
Old :Record
Color:Word;
Style:FillSettingsType;
End;
Begin
Mouse.Hide;
GetFillSettings(Old.Style);
If Header<>'' Then
Begin
Old.Color:=GetColor;
SetColor (HdrFrg);
SetFillStyle (HdrPattern,HdrFillColor);
Bar(X1+Thickness+2,Y1+Thickness+2,X2-Thickness-2,Y1+Thickness+12);
Case HdrFmt Of
LeftText :XPos:=X1+4;
CentreText:XPos:=X1+((X2-X1) Div 2)-(Length(Header)*4);
RightText :XPos:=X2-2*Thickness-(Length(Header)*8)-2;
End;
OutTextXY(XPos+Thickness,Y1+4+Thickness,Header);
SetColor(Old.Color);
End
Else
Begin
SetFillStyle (Pattern,FillColor);
Bar(X1+Thickness+2,Y1+Thickness+2,X2-Thickness-2,Y1+Thickness+12);
End;
SetFillStyle(Old.Style.Pattern,Old.Style.Color);
Mouse.Show;
End;
Procedure GraphicWindow.NewHeading(NewHead:String;NewMode:TextFormats;
Forg,Patrn,PatClr:Word);
Begin
HdrFrg:=Forg;
HdrPattern:=Patrn;
HdrFillColor:=PatClr;
HdrFmt:=NewMode;
If NewHead='' Then
Header:=''
Else
Header:=NewHead;
DisplayHeading;
End;
Procedure GraphicWindow.Hide;
Var
NewSave :Pointer;
Begin
Status:=Hidden;
If KeepBack Then
Begin
If Size>MaxAvail Then Error(1);
GetMem(NewSave,Size);
Mouse.Hide;
GetImage(X1,Y1,X2,Y2,NewSave^);
PutImage(X1,Y1,Save^,NormalPut);
Mouse.Show;
FreeMem(Save,Size);
Save:=NewSave;
End
Else
Begin
Mouse.Hide;
SetFillStyle(SolidFill,BoxBck);
Bar(X1,Y1,X2,Y2);
Mouse.Show;
End;
End;
Procedure GraphicWindow.Show;
Var
NewSave :Pointer;
Begin
Status:=Visible;
If KeepBack Then
Begin
If Size>MaxAvail Then Error(1);
GetMem(NewSave,Size);
Mouse.Hide;
GetImage(X1,Y1,X2,Y2,NewSave^);
PutImage(X1,Y1,Save^,NormalPut);
Mouse.Show;
FreeMem(Save,Size);
Save:=NewSave;
End
Else
Begin
DrawWindow;
DisplayHeading;
If CloseButtonNum<>0 Then
PutImage(X1+Thickness+2,Y1+Thickness+2,IconCloseButton^,CopyPut);
If VSlideButtonNum<>0 Then DrawVertSlideBar;
If HSlideButtonNum<>0 Then DrawHorzSlideBar;
End;
End;
Procedure GraphicWindow.NewPosition(NewX,NewY:Word);
Begin
Hide;
Buttons.MoveAll(Integer(NewX)-X1,Integer(NewY)-Y1);
X2:=NewX+(X2-X1);
Y2:=NewY+(Y2-Y1);
X1:=NewX;
Y1:=NewY;
Show;
End;
Procedure GraphicWindow.DrawOutLine(NewX,NewY:Word;Var OutLine:OutLineSave);
Var
OldClr:Word;
Begin
X2:=NewX+(X2-X1); {Saves the outline screen area of a box}
Y2:=NewY+(Y2-Y1); {and then draws the outline of the box.}
X1:=NewX; {Saves the old screen area into OutLine.}
Y1:=NewY;
With OutLine do
Begin
Size1:=ImageSize(X1,Y1,X2,Y1); {Horizontal}
Size2:=ImageSize(X1,Y1,X1,Y2); {Vertical}
If 2*Size1+2*Size2>MaxAvail Then Error(1);
GetMem(Data[1],Size1);
GetMem(Data[2],Size1);
GetMem(Data[3],Size2);
GetMem(Data[4],Size2);
Mouse.Hide;
GetImage(X1,Y1,X2,Y1,Data[1]^);
GetImage(X1,Y2,X2,Y2,Data[2]^);
GetImage(X1,Y1,X1,Y2,Data[3]^);
GetImage(X2,Y1,X2,Y2,Data[4]^);
Mouse.Show;
End;
OldClr:=GetColor;
SetColor(BoxFrg);
Mouse.Hide;
Rectangle(X1,Y1,X2,Y2);
Mouse.Show;
SetColor(OldClr);
End;
Procedure GraphicWindow.NoOutLine(Var OutLine:OutLineSave);
Begin
With OutLine do
Begin
Mouse.Hide;
PutImage(X1,Y1,Data[1]^,NormalPut); {Restores the screen to as it}
PutImage(X1,Y2,Data[2]^,NormalPut); {was before DrawOutLine was called.}
PutImage(X1,Y1,Data[3]^,NormalPut);
PutImage(X2,Y1,Data[4]^,NormalPut);
Mouse.Show;
FreeMem(Data[1],Size1);
FreeMem(Data[2],Size1);
FreeMem(Data[3],Size2);
FreeMem(Data[4],Size2);
Size1:=0;
End;
End;
Procedure GraphicWindow.Drag;
Var
MouseL,
MouseR,
MouseM,
MouseMoved,
MouseRelease :Boolean;
OldMouseX,
OldMouseY,
MouseX,
MouseY,
MouseStartX,
MouseStartY,
MouseDistX,
MouseDistY,
NewX,
NewY,
OldX,
OldY :Word;
C :Char;
OldBut :Pointer;
OldData :OutLineSave;
Begin
OldBut:=Buttons.Buttons;
If Mouse.Active Then
Begin
C:=#1;
OldMouseX:=65535;
OldMouseY:=65535;
MouseStartX:=((X2-X1) Div 2) + X1;
MouseStartY:=(Y1+Thickness+4);
MouseDistX:=MouseStartX-X1;
MouseDistY:=MouseStartY-Y1;
Mouse.SetXY(MouseStartX,MouseStartY);
End;
MouseRelease:=False;
OldX:=X1;
OldY:=Y1;
Repeat
Repeat
MouseMoved:=False;
KeyBuffer(Clear);
DrawOutLine(X1,Y1,OldData); {Flashing Outline of a Box}
NoOutLine(OldData);
If Mouse.Active Then
Begin
Mouse.GetStatus(MouseX,MouseY,MouseL,MouseR,MouseM);
If (MouseX<>OldMouseX) Or (MouseY<>OldMouseY) Then MouseMoved:=True;
If (Not MouseL) And (Not MouseR) Then MouseRelease:=True;
End;
Until KeyPressed Or MouseMoved Or MouseRelease;
If MouseMoved Then
Begin
If LongInt(MouseX)-LongInt(MouseDistX)<0 Then
OldMouseX:=0
Else
OldMouseX:=MouseX-MouseDistX;
If LongInt(MouseY)-LongInt(MouseDistY)<0 Then
OldMouseY:=0
Else
OldMouseY:=MouseY-MouseDistY;
If (OldMouseX+(